home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
tex
/
ptf12.zip
/
PTFSPEC.SRC
< prev
next >
Wrap
Text File
|
1990-05-12
|
82KB
|
2,715 lines
--::::::::::
--clp.a
--::::::::::
--X1804: CSC
-- **********************************************
-- * *
-- * COMMAND_LINE_PROCESSOR * SPEC
-- * *
-- **********************************************
package COMMAND_LINE_PROCESSOR is
--| Purpose
--| COMMAND_LINE_PROCESSOR is an abstract state machine
--| that allows the user to access a command line, which
--| may contain file references which are include files,
--| as a simple list of file names which can be accessed
--| via an interator and a Get function. The command line
--| syntax is:
--|
--| command input_file input_file ... output_file
--| or:
--| command input_file input_file ... input_file
--|
--| where any "input_file" may be prefixed by an "@"
--| to make it an include file.
--|
--| Initialization Exceptions (none)
--| Notes
--| This package depends on package CLI from the ASR
--| File: PD2:<ADA.COMPONENTS>CLI2.SRC
--| Modifications
--| 2/19/90 Rick Conn Initial Design and Code
--| 5/7/90 Rick Conn Cleanup and removal of FILE_LISTER2
INCLUDE_FILE_PREFIX : constant CHARACTER := '@';
-- This character is the prefix flag for an include
-- file name.
MAX_FILE_NAME_LENGTH : constant := 200;
-- Maximum length of a file name (change this
-- to match the target operating system)
type COMMAND_LINE_LAYOUT is (ALL_INPUT_FILES,
ONE_OUTPUT_FILE);
-- The command line either contains only input
-- files or a group of input files and one
-- output file. COMMAND_LINE_LAYOUT distinguishes
-- command lines of the form
-- PROGRAM_NAME infile infile ...
-- from command lines of the form
-- PROGRAM_NAME infile infile ... outfile
--X1804: CSU
-- ..............................................
-- . .
-- . INITIALIZE . SPEC
-- . .
-- ..............................................
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_KIND : in COMMAND_LINE_LAYOUT
:= ONE_OUTPUT_FILE);
--| Purpose
--| Initialize the package, specifying a program
--| name which may be used by the Command Line
--| Interface.
--X1804: CSU
-- ..............................................
-- . .
-- . RESET . SPEC
-- . .
-- ..............................................
procedure RESET;
--| Purpose
--| Reset the iterator so the next call to FILE_NAME
--| returns the first file in the list. If this
--| package is iterated over only once, RESET need
--| not be called.
--X1804: CSU
-- ..............................................
-- . .
-- . IS_END . SPEC
-- . .
-- ..............................................
function IS_END return BOOLEAN;
--| Purpose
--| Indicate if any more file names are available.
--| Return TRUE if not.
--X1804: CSU
-- ..............................................
-- . .
-- . FILE_NAME . SPEC
-- . .
-- ..............................................
function FILE_NAME return STRING;
--| Purpose
--| Return the name of the next file and increment
--| the iterator.
--X1804: CSU
-- ..............................................
-- . .
-- . OUTPUT_FILE_NAME . SPEC
-- . .
-- ..............................................
function OUTPUT_FILE_NAME return STRING;
--| Purpose
--| Return the name of the output file. If INITIALIZE
--| was called with ALL_INPUT_FILES, return a null string.
--X1804: CSU
-- ..............................................
-- . .
-- . FILE_NAME_COUNT . SPEC
-- . .
-- ..............................................
function FILE_NAME_COUNT return NATURAL;
--| Purpose
--| Return the number of file names in command line.
--| This is like CLI.ARGC-1, and is a token count. It
--| returns the same value regardless if ALL_INPUT_FILES or
--| ONE_OUTPUT_FILE was used.
ALLOCATION_PROBLEM : exception; -- raised by INITIALIZE
END_OF_FILE_LIST : exception; -- raised by FILE_NAME
INIT_ERROR : exception; -- raised when INITIALIZE
-- not called
INCLUDE_FILE_NOT_FOUND : exception; -- raised by INITIALIZE
UNEXPECTED_ERROR : exception;
end COMMAND_LINE_PROCESSOR;
--::::::::::
--dyn.a
--::::::::::
package DYN is
-- This package is derived from DSTR3.SRC in the Ada Software Repository
-- DSTR3.SRC was written by R.G. Cleaveland. The derivation, done by
-- Richard Conn, was done to remove those general-purpose features of the
-- package not needed for the PTF project.
------------------------------------------------------------------------------
-- This is a package of several string manipulation functions based on --
-- a built-in dynamic STRING type DYN_STRING. It is an adaptation and --
-- extension of the package proposed by Sylvan Rubin of Ford Aerospace and --
-- Communications Corporation in the Nov/Dec 1984 issue of the Journal of --
-- Pascal, Ada and Modula-2. Some new functions have been added, and much --
-- of the body code has been rewritten. --
------------------------------------------------------------------------------
-- R.G. Cleaveland 07 December 1984: --
-- Implementation initially with the Telesoft Ada version 1.3. --
-- 06 Feb 85: CHAR changed to add the optional parameter POSIT. --
-- 06 Feb 85: procedure SUBSTITUTE added. --
-- 05 Apr 85: procedures UPPERCASE and CHECKBYTE added. --
-- 04 Feb 86: style and formatting changes made, some comments fixed. --
-- Ported to VERDIX VADS (VAX Ultrix version 5.1). --
-- 10 Feb 86: Several bugs fixed - SIZE constrained, exception for '&' --
-- generating too long a string added, error in integer conversion fixed. --
-- Functions EQUALS, ">", "<=" and ">=" added. Subtype DS_POS incorporated.--
------------------------------------------------------------------------------
MAX_D_STRING_LENGTH : constant POSITIVE := 100;
-- This is the maximum LENGTH of a dynamic string implemented with this
-- package. This value is "arbitrary" in that any reasonable number
-- equal to or less than the maximum STRING LENGTH permitted by the
-- compiler is acceptable. The specific value above was chosen as a
-- compromise between programmer convenience and memory space requirements.
subtype DS_POS is INTEGER range 0..MAX_D_STRING_LENGTH;
type DYN_STRING is private;
STRING_TOO_SHORT: exception;
function D_STRING(CHAR: CHARACTER) return DYN_STRING;
-- Creates a one-byte dynamic string of contents CHAR.
function D_STRING(STR : STRING ) return DYN_STRING;
-- Creates a dynamic string of contents STR.
function CHAR(DSTR : DYN_STRING;
POSIT : POSITIVE := 1) return CHARACTER;
function STR (DSTR: DYN_STRING) return STRING;
function LENGTH(DSTR: DYN_STRING) return NATURAL;
-- returns the LENGTH of the dynamic string.
procedure CLEAR(DSTR: in out DYN_STRING);
-- makes DSTR a null string.
private
type DYN_STRING is
record
SIZE: INTEGER range 0..MAX_D_STRING_LENGTH;
DATA: STRING(1..MAX_D_STRING_LENGTH);
end record;
end DYN;
package body DYN is
procedure CLEAR(DSTR: in out DYN_STRING) is
begin
DSTR.SIZE := 0;
end CLEAR;
function D_STRING(CHAR: CHARACTER) return DYN_STRING is
DS : DYN_STRING;
begin
DS.SIZE := 1;
DS.DATA(1) := CHAR;
return DS;
end D_STRING;
function D_STRING(STR : STRING ) return DYN_STRING is
DS : DYN_STRING;
begin
DS.SIZE := STR'LENGTH;
DS.DATA(1..DS.SIZE) := STR;
return DS;
end D_STRING;
function CHAR(DSTR : DYN_STRING;
POSIT : POSITIVE := 1) return CHARACTER is
begin
if POSIT > DSTR.SIZE then
raise STRING_TOO_SHORT;
else
return DSTR.DATA(POSIT);
end if;
end CHAR;
function STR (DSTR: DYN_STRING) return STRING is
begin
return DSTR.DATA(1..DSTR.SIZE);
end STR;
function LENGTH(DSTR: DYN_STRING) return NATURAL is
begin
return DSTR.SIZE;
end LENGTH;
begin --(DYN)
null;
exception
when others =>
raise;
end DYN;
--::::::::::
--sort.a
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
-- -*
-- Unit name : generic procedure SORT
-- Version : 1.0
-- Author : John A. Anderson
-- : TEXAS INSTRUMENTS MS 8006
-- : P.O. BOX 801
-- : MCKINNEY, TEXAS 75069
-- :
-- DDN Address : ANDERSON%TI-EG at CSNET-RELAY
-- Copyright : (c) 1984, 1985 John Anderson
-- Date created : December 19, 1984
-- Release Date : January 10, 1985
-- Last update : ANDERSON Wed Dec 19, 1984
-- Machine/System Compiled/Run on : DG MV 10000, Ada Development
-- : Environment
-- -*
---------------------------------------------------------------
-- -*
-- Abstract : This generic procedure uses the QuickSort
----------------: algorithm to sort an array of any base type
----------------: with any discrete index type.
----------------: Associated Files:
----------------: SORT.ADA -- generic Quick Sort
----------------: OTHERTEST.ADA -- test program (for any
----------------: generic sort with the same visible section
----------------:
------------------ Revision history ---------------------------
--
-- DATE AUTHOR HISTORY
-- 10 Jan 85 John Anderson Initial Release
--
-------------------END-PROLOGUE--------------------------------
generic
type ITEM is private;
type INDEX is (<>);
type ROW is array (INDEX range <>) of ITEM;
with function "<" (X, Y : ITEM) return BOOLEAN is <>;
procedure SORT (A : in out ROW);
with TEXT_IO;
procedure SORT (A : in out ROW) is
procedure QSORT (L, R : INDEX) is
I, J : INDEX;
X : ITEM;
procedure EXCHANGE (A, B : in out ITEM) is
TEMP : ITEM;
begin
TEMP := A;
A := B;
B := TEMP;
end EXCHANGE;
begin
I := L;
J := R;
X := A (INDEX'VAL ((INDEX'POS (L) + INDEX'POS (R)) / 2));
MAIN:
loop
while A (I) < X loop
I := INDEX'SUCC (I);
end loop;
while X < A (J) loop
J := INDEX'PRED (J);
end loop;
if I <= J then
EXCHANGE (A (I), A (J));
begin
I := INDEX'SUCC (I);
J := INDEX'PRED (J);
exception
when CONSTRAINT_ERROR =>
null; -- necessary to avoid exception raising
end;
end if;
exit when I > J;
end loop MAIN;
if L < J then
QSORT (L, J);
end if;
if I < R then
QSORT (I, R);
end if;
end QSORT;
begin
QSORT (A'FIRST, A'LAST);
exception
when others =>
TEXT_IO.PUT_LINE ("Exception raised in Generic Sort");
raise;
end SORT;
--::::::::::
--cot.a
--::::::::::
-- **********************************
-- * *
-- * Console * SPEC
-- * *
-- **********************************
package Console is
--| Purpose
--| Console implements an abstract state machine of a console terminal.
--| Console offers an abstraction that can be made more efficient
--| by not using Text_IO (and having its associated overhead imposed)
--| if possible.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
-- ..................................
-- . .
-- . Put . SPEC
-- . .
-- ..................................
procedure Put
( Item : in CHARACTER );
procedure Put
( Item : in STRING );
--| Purpose
--| Put writes an Item to the console.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Put_Line . SPEC
-- . .
-- ..................................
procedure Put_Line
( Item : in STRING );
--| Purpose
--| Put_Line writes an Item to the console. The Item is followed
--| by a New_Line;
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . New_Line . SPEC
-- . .
-- ..................................
procedure New_Line;
--| Purpose
--| New_Line writes an end-of-line sequence to the console.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Get_Line . SPEC
-- . .
-- ..................................
procedure Get_Line
( Item : out STRING;
Last : out NATURAL );
--| Purpose
--| Get_Line reads a line from the console.
--|
--| Exceptions (none)
--| Notes (none)
end Console;
--::::::::::
--in.a
--::::::::::
-- **********************************
-- * *
-- * Input_File * SPEC
-- * *
-- **********************************
package Input_File is
--| Purpose
--| Input_File implements an abstract data type of an input file.
--| Input_File offers an abstraction that can be made more efficient
--| by not using Text_IO (and having its associated overhead imposed)
--| if possible,
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
type FILE_TYPE is
private;
Cannot_Open_Input_File
: exception;
Read_Error
: exception;
-- ..................................
-- . .
-- . Open . SPEC
-- . .
-- ..................................
procedure Open
( Id : in out FILE_TYPE;
File_Name : in STRING );
--| Purpose
--| Open an existing FILE_TYPE object.
--|
--| Exceptions
--| Cannot_Open_Input_File
--|
--| Notes (none)
-- ..................................
-- . .
-- . Get_Line . SPEC
-- . .
-- ..................................
procedure Get_Line
( Id : in out FILE_TYPE;
Item : out STRING;
Last : out NATURAL );
--| Purpose
--| Get_Line reads an Item to the FILE_TYPE object.
--|
--| Exceptions
--| Read_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . End_Of_File . SPEC
-- . .
-- ..................................
function End_Of_File
( Id : in FILE_TYPE )
return BOOLEAN;
--| Purpose
--| End_Of_File returns TRUE if the FILE_TYPE object is empty or
--| no more data is in it.
--|
--| Exceptions
--| Read_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close
( Id : in out FILE_TYPE );
--| Purpose
--| Close closes input from the FILE_TYPE object.
--|
--| Exceptions (none)
--| Notes (none)
private -- Input_File
type FILE_OBJECT;
type FILE_TYPE is
access FILE_OBJECT;
end Input_File;
--::::::::::
--out.a
--::::::::::
-- **********************************
-- * *
-- * Output_File * SPEC
-- * *
-- **********************************
package Output_File is
--| Purpose
--| Output_File implements an abstract data type of an output file.
--| Output_File offers an abstraction that can be made more efficient
--| by not using Text_IO (and having its associated overhead imposed)
--| if possible and also offers the ability to suppress the output,
--| which may be desired if a caller is skipping over pages and just
--| wants to output to a null device during this process.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
type FILE_TYPE is
private;
Cannot_Create_Output_File
: exception;
Write_Error
: exception;
-- ..................................
-- . .
-- . Already_Exists . SPEC
-- . .
-- ..................................
function Already_Exists
( File_Name : in STRING )
return BOOLEAN;
--| Purpose
--| Determine if the FILE_TYPE object already exists.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Delete . SPEC
-- . .
-- ..................................
function Delete
( File_Name : in STRING )
return BOOLEAN;
--| Purpose
--| Delete the FILE_TYPE object. Return TRUE if successful.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Create . SPEC
-- . .
-- ..................................
procedure Create
( Id : in out FILE_TYPE;
File_Name : in STRING );
--| Purpose
--| Create creates a new FILE_TYPE object.
--|
--| Exceptions
--| Cannot_Create_Output_File
--|
--| Notes (none)
-- ..................................
-- . .
-- . Put . SPEC
-- . .
-- ..................................
procedure Put
( Id : in out FILE_TYPE;
Item : in CHARACTER );
procedure Put
( Id : in out FILE_TYPE;
Item : in STRING );
--| Purpose
--| Put writes an Item to the FILE_TYPE object.
--|
--| Exceptions
--| Write_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . Put_Line . SPEC
-- . .
-- ..................................
procedure Put_Line
( Id : in out FILE_TYPE;
Item : in STRING );
--| Purpose
--| Put_Line writes an Item to the FILE_TYPE object. The Item is followed
--| by a New_Line;
--|
--| Exceptions
--| Write_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . New_Line . SPEC
-- . .
-- ..................................
procedure New_Line
( Id : in out FILE_TYPE );
--| Purpose
--| New_Line writes an end-of-line sequence to the FILE_TYPE object.
--|
--| Exceptions
--| Write_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . New_Page . SPEC
-- . .
-- ..................................
procedure New_Page
( Id : in out FILE_TYPE );
--| Purpose
--| New_Page writes an end-of-page sequence to the FILE_TYPE object.
--|
--| Exceptions
--| Write_Error
--|
--| Notes (none)
-- ..................................
-- . .
-- . Enable_Output . SPEC
-- . Disable_Output .
-- . .
-- ..................................
procedure Enable_Output
( Id : in out FILE_TYPE );
procedure Disable_Output
( Id : in out FILE_TYPE );
--| Purpose
--| Enable_Output and Disable_Output enable and disable the output of
--| Items and new lines to the FILE_TYPE object. When created, output
--| to a FILE_TYPE object is enabled.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close
( Id : in out FILE_TYPE );
--| Purpose
--| Close closes output to the FILE_TYPE object.
--|
--| Exceptions (none)
--| Notes (none)
private -- Output_File
type FILE_OBJECT;
type FILE_TYPE is
access FILE_OBJECT;
end Output_File;
--::::::::::
--cmd_sym.a
--::::::::::
-- **********************************
-- * *
-- * Command_Symbols * SPEC & BODY
-- * *
-- **********************************
package Command_Symbols is
--| Purpose
--| Command_Symbols contains the command name table used by the body of
--| package Command. It also contains the error messages issued by
--| routines within the package.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Added .du, .eu commands
Command_Text_Length
: constant
:= 12;
Ltw_Length
: constant
:= 20;
type COMMAND_ID is
( UNKNOWN, AUTO_PARAGRAPH, BOLD, BREAK, CENTER, COMMENT, CONSOLE_MESSAGE,
CONTENTS_SELECT, DISABLE_BOLDING, ENABLE_BOLDING, ENTER_CONTENTS,
ENVIRONMENT_POP, ENVIRONMENT_PUSH, FILL, FOOTER, FOOTER_EVEN,
FOOTER_ODD, HEADER, HEADER_EVEN, HEADER_ODD, INCLUDE, INDEX_ENTRY,
INDEX_LENGTH, JUSTIFY, LEFT_INDENT, LEFT_MARGIN,
LEX, LINE_SPACING, NL_BOTTOM, NL_FOOTER, NL_HEADER, NL_TOP,
NO_AUTO_PARAGRAPH, NO_FILL, NO_JUSTIFY, NO_PAGING, NUMBER_REGISTER,
OFFSET, PAGE, PAGE_NUMBER_FORMAT, PAGE_SIZE, PAGING, PRINT_CONTENTS,
RIGHT_INDENT, RIGHT_MARGIN, SET_CCHAR, SET_ECHAR, SET_FCHAR, SKIP,
SPACE_TO, START_MACRO, STOP_MACRO, TEMPORARY_INDENT, TEST_PAGE,
UNDERLINE, UNDERLINE_MODE, DISABLE_UNDERLINING, ENABLE_UNDERLINING,
VARIABLE_GET, VARIABLE_SET, WRITE );
subtype COMMAND_TEXT is
STRING (1 .. Command_Text_Length);
type COMMAND_DEFINITION is
record
Id : COMMAND_ID;
Name : COMMAND_TEXT;
end record;
type COMMAND_LIST is
array (NATURAL range <>)
of COMMAND_DEFINITION;
pragma Format_Off;
Cl
: COMMAND_LIST(1..120)
:= (
(AUTO_PARAGRAPH, "ap "),
(BOLD, "bd "),
(BOLD, "bold "),
(BREAK, "br "),
(BREAK, "break "),
(CENTER, "ce "),
(CENTER, "center "),
(COMMENT, "# "),
(COMMENT, ". "),
(COMMENT, "! "),
(COMMENT, "comment "),
(CONSOLE_MESSAGE, "con "),
(CONSOLE_MESSAGE, "console "),
(CONSOLE_MESSAGE, "msg "),
(CONTENTS_SELECT, "contsel "),
(DISABLE_BOLDING, "db "),
(DISABLE_BOLDING, "dbo "),
(ENABLE_BOLDING, "eb "),
(ENABLE_BOLDING, "ebo "),
(ENTER_CONTENTS, "cl "),
(ENTER_CONTENTS, "contline "),
(ENVIRONMENT_POP, "restore "),
(ENVIRONMENT_POP, "rs "),
(ENVIRONMENT_PUSH, "save "),
(ENVIRONMENT_PUSH, "sv "),
(FILL, "f "),
(FILL, "fi "),
(FILL, "fill "),
(FOOTER, "fo "),
(FOOTER, "footer "),
(FOOTER_EVEN, "ef "),
(FOOTER_ODD, "of "),
(HEADER, "he "),
(HEADER, "header "),
(HEADER_EVEN, "eh "),
(HEADER_ODD, "oh "),
(INCLUDE, "include "),
(INCLUDE, "so "),
(INCLUDE, "source "),
(INCLUDE, "require "),
(INDEX_ENTRY, "index "),
(INDEX_ENTRY, "idx "),
(INDEX_LENGTH, "indexlength "),
(JUSTIFY, "j "),
(JUSTIFY, "ju "),
(JUSTIFY, "justify "),
(LEFT_INDENT, "in "),
(LEFT_INDENT, "indent "),
(LEFT_INDENT, "li "),
(LEFT_INDENT, "leftindent "),
(LEFT_MARGIN, "leftmargin "),
(LEFT_MARGIN, "lm "),
(LEX, "lex "),
(LEX, "lx "),
(LINE_SPACING, "ls "),
(LINE_SPACING, "spacing "),
(LINE_SPACING, "spc "),
(NL_BOTTOM, "nlbottom "),
(NL_FOOTER, "nlfooter "),
(NL_HEADER, "nlheader "),
(NL_TOP, "nltop "),
(NO_AUTO_PARAGRAPH, "na "),
(NO_AUTO_PARAGRAPH, "nap "),
(NO_FILL, "nf "),
(NO_FILL, "nofill "),
(NO_JUSTIFY, "nj "),
(NO_JUSTIFY, "nojustify "),
(NO_PAGING, "nopaging "),
(NO_PAGING, "np "),
(NUMBER_REGISTER, "nr "),
(OFFSET, "offset "),
(OFFSET, "po "),
(PAGE, "bp "),
(PAGE, "page "),
(PAGE, "pg "),
(PAGE_NUMBER_FORMAT, "pagenumber "),
(PAGE_NUMBER_FORMAT, "pn "),
(PAGE_SIZE, "pagesize "),
(PAGE_SIZE, "pl "),
(PAGE_SIZE, "ps "),
(PAGING, "pa "),
(PAGING, "paging "),
(PRINT_CONTENTS, "pc "),
(PRINT_CONTENTS, "printcont "),
(RIGHT_INDENT, "ri "),
(RIGHT_INDENT, "rightindent "),
(RIGHT_MARGIN, "rightmargin "),
(RIGHT_MARGIN, "rm "),
(SET_CCHAR, "cc "),
(SET_CCHAR, "cchar "),
(SET_ECHAR, "ec "),
(SET_ECHAR, "echar "),
(SET_FCHAR, "fc "),
(SET_FCHAR, "fchar "),
(SKIP, "s "),
(SKIP, "skip "),
(SKIP, "sp "),
(SPACE_TO, "spaceto "),
(SPACE_TO, "st "),
(START_MACRO, "de "),
(START_MACRO, "define "),
(STOP_MACRO, "en "),
(TEMPORARY_INDENT, "i "),
(TEMPORARY_INDENT, "left "),
(TEMPORARY_INDENT, "ti "),
(TEST_PAGE, "ne "),
(TEST_PAGE, "need "),
(TEST_PAGE, "testpage "),
(TEST_PAGE, "tp "),
(UNDERLINE, "ul "),
(UNDERLINE, "underline "),
(UNDERLINE_MODE, "ulmode "),
(DISABLE_UNDERLINING, "du "),
(ENABLE_UNDERLINING, "eu "),
(VARIABLE_GET, "get "),
(VARIABLE_GET, "vg "),
(VARIABLE_SET, "set "),
(VARIABLE_SET, "vs "),
(WRITE, "wr "),
(WRITE, "write ")
);
pragma Format_On;
Error_Create
: constant STRING
:= "4.1.A. Cannot create output file";
Error_Delete_File
: constant STRING
:= "4.1.B. Cannot delete old output file";
Error_Expansion
: constant STRING
:= "4.1.C. Not enough room to expand line";
Error_Fatal
: constant STRING
:= "4.1.D. Unexpected fatal error";
Error_Hf_Lines
: constant STRING
:= "4.1.E. Range error on number of header or footer lines";
Error_Include
: constant STRING
:= "4.1.F. Error in include file: ";
Error_Indent
: constant STRING
:= "4.1.G. Indentation would move to before page boundary";
Error_Index_File_Create
: constant STRING
:= "4.1.H. Cannot create index file";
Error_Internal_Add_Index_Entry
: constant STRING
:= "4.2.A. Internal error in Index.Add_Entry";
Error_Internal_Add_Line
: constant STRING
:= "4.2.B. Internal error in Contents.Add_Line";
Error_Internal_Break_Line
: constant STRING
:= "4.2.C. Internal error in FOF.Break_Line";
Error_Internal_Break_Page_1
: constant STRING
:= "4.2.D. Internal error in FOF.Break_Page (1st routine)";
Error_Internal_Break_Page_2
: constant STRING
:= "4.2.E. Internal error in FOF.Break_Page (2nd routine)";
Error_Internal_Bottom
: constant STRING
:= "4.2.F. Internal error in FOF.Output_Bottom_Of_Page";
Error_Internal_Hf_Line
: constant STRING
:= "4.2.G. Internal error in FOF.Put_Header_Footer_Line";
Error_Internal_Identify
: constant STRING
:= "4.2.H. Internal error in Command.Identify";
Error_Internal_Increment
: constant STRING
:= "4.2.I. Internal error in Variable.Increment_Line_Number";
Error_Internal_Macro_Define
: constant STRING
:= "4.2.J. Internal error in Macro.Define_Parameters";
Error_Internal_Macro_Write
: constant STRING
:= "4.2.K. Internal error in Macro.Write";
Error_Internal_Open
: constant STRING
:= "4.2.L. Internal error in Word_Processor.Open_Output_File";
Error_Internal_Pnum
: constant STRING
:= "4.2.M. Internal error in FOF.Pnum_As_String";
Error_Internal_Process
: constant STRING
:= "4.2.N. Internal error in Command.Process";
Error_Internal_Print
: constant STRING
:= "4.2.O. Internal error in Contents.Print";
Error_Internal_Put_Invisible
: constant STRING
:= "4.2.P. Internal error in FOF.Put_Invisible_Word";
Error_Internal_Put_Line
: constant STRING
:= "4.2.Q. Internal error in FOF.Put_Line";
Error_Internal_Put_What
: constant STRING
:= "4.2.R. Internal error in FOF.Put_Word.Put_What";
Error_Internal_Put_Word
: constant STRING
:= "4.2.S. Internal error in FOF.Put_Word";
Error_Internal_Set_Footer_Line
: constant STRING
:= "4.2.T. Internal error in FOF.Set_Footer_Line";
Error_Internal_Set_Header_Line
: constant STRING
:= "4.2.U. Internal error in FOF.Set_Header_Line";
Error_Internal_Set_Var
: constant STRING
:= "4.2.V. Internal error in Variable.Set_Var";
Error_Internal_Skip
: constant STRING
:= "4.2.W. Internal error in FOF.Skip";
Error_Internal_Top
: constant STRING
:= "4.2.X. Internal error in FOF.Output_Top_Of_Page";
Error_Internal_PTFIDX
: constant STRING
:= "4.2.Y. Internal error in PTFIDX";
Error_Invalid_Option
: constant STRING
:= "4.1.I. Invalid option (not -db or -po#) in command line";
Error_Lex
: constant STRING
:= "4.1.J. No arguments given to .lex command";
Error_Macro
: constant STRING
:= "4.1.K Error in macro definition";
Error_Macro_End
: constant STRING
:= "4.1.L. Isolated macro end (.en) encountered";
Error_Macro_Unknown_Command
: constant STRING
:= "4.1.M. Unknown command/macro in macro definition";
Error_Margin
: constant STRING
:= "4.1.N. Left starting column greater than right";
Error_Number
: constant STRING
:= "4.1.O. Numeric conversion problem on ";
Error_Number_Register
: constant STRING
:= "4.1.P. Error in number register definition ";
Error_Page_Number_Format
: constant STRING
:= "4.1.Q. Invalid page number format requested";
Error_Source_File
: constant STRING
:= "4.1.R. Error in processing source file";
Error_Spaceto
: constant STRING
:= "4.1.S. Spaceto request is before current line";
Error_Stack_Empty
: constant STRING
:= "4.1.T. Restore requested of an empty stack";
Error_Stack_Overflow
: constant STRING
:= "4.1.U. Save resulted in an overflow of the stack -- save not done";
Error_Unknown
: constant STRING
:= "4.1.V. Unknown command";
Error_User_Abort
: constant STRING
:= "4.1.W. User Abort";
Error_Write
: constant STRING
:= "4.1.X. Write command buffer overflow";
Error_Variable_Set
: constant STRING
:= "4.1.Y. Error in variable get or set command";
Error_Variable_Name
: constant STRING
:= "4.1.Z. Variable not found";
Warning_Contents_Line_Truncation
: constant STRING
:= "4.3.A. Contents line too long - truncated";
Warning_Contents_Number
: constant STRING
:= "4.3.B. Invalid contents number - table 0 selected";
Warning_Index_Line_Truncation
: constant STRING
:= "4.3.C. Index line too long - truncated";
Warning_Index_Width
: constant STRING
:= "4.3.D. Index line too wide (index not in margins)";
Warning_Table_Empty
: constant STRING
:= "4.3.E. Current contents table is empty";
end Command_Symbols;
--::::::::::
--err.a
--::::::::::
-- **********************************
-- * *
-- * Error_Log * SPEC
-- * *
-- **********************************
package Error_Log is
--| Purpose
--| Error_Log is used to log errors to an output file or console.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
-- ..................................
-- . .
-- . Open . SPEC
-- . .
-- ..................................
procedure Open
( File_Name : in STRING );
--| Purpose
--| Open the error log file. If the File_Name is empty, error log
--| goes to standard output.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Write_Error . SPEC
-- . .
-- ..................................
procedure Write_Error
( Message : in STRING );
--| Purpose
--| Write_Error makes an error message entry into the error log file.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Write_Warning . SPEC
-- . .
-- ..................................
procedure Write_Warning
( Message : in STRING );
--| Purpose
--| Write_Warning makes a warning message entry into the error log file.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close;
--| Purpose
--| Close closes the error log file.
--|
--| Exceptions (none)
--| Notes (none)
end Error_Log;
--::::::::::
--idx.a
--::::::::::
-- **********************************
-- * *
-- * Index * SPEC
-- * *
-- **********************************
package Index is
--| Purpose
--| Index is an abstract state machine which implements an index
--| of a document.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
Index_File_Not_Open
: exception;
Create_Error
: exception;
-- ..................................
-- . .
-- . Create . SPEC
-- . .
-- ..................................
procedure Create
( File_Name : in STRING;
Line_Width : in NATURAL;
Text_Line_Width : in NATURAL;
Text_Line_Count : in NATURAL );
--| Purpose
--| Create creates the index file, setting the width of the lines.
--|
--| Exceptions
--| Create_Error -- file cannot be created
--| Notes (none)
-- ..................................
-- . .
-- . Add_Entry . SPEC
-- . .
-- ..................................
procedure Add_Entry
( Text : in STRING;
Page_Number : in STRING );
--| Purpose
--| Add_Entry adds an entry to the index file. If the text is too
--| long, it is simply truncated with a warning message.
--|
--| Exceptions
--| Index_File_Not_Open -- Create was not called yet
--|
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close;
--| Purpose
--| Close closes an index file.
--|
--| Exceptions (none)
--| Notes (none)
end Index;
--::::::::::
--var.a
--::::::::::
-- **********************************
-- * *
-- * Variable * SPEC
-- * *
-- **********************************
package Variable is
--| Purpose
--| Package Variable defines and provides access to the following
--| variables:
--| 1. Number Registers a-z
--| 2. Command Control Character
--| 3. Escape Character
--| 4. Flag Character
--| 5. Auto-Paragraphing Flag
--| 6. Bold line, Center line, and Underlined line counts
--| 7. Current File Name and Line Number
--| 8. User-Defined Text Variables
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
-- ..................................
-- . .
-- . Set_Auto_Paragraph . SPEC
-- . Is_Auto_Paragraph .
-- . .
-- ..................................
Default_Auto_Paragraph
: constant BOOLEAN
:= false;
procedure Set_Auto_Paragraph
( Item : in BOOLEAN );
function Is_Auto_Paragraph
return BOOLEAN;
--| Purpose
--| Set and return the value of the auto paragraphing flag.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Bold_Count . SPEC
-- . Bold_Count .
-- . .
-- ..................................
procedure Set_Bold_Count
( Value : in NATURAL );
function Bold_Count
return NATURAL;
--| Purpose
--| Set and return the value of the bold count.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Center_Count . SPEC
-- . Center_Count .
-- . .
-- ..................................
procedure Set_Center_Count
( Value : in NATURAL );
function Center_Count
return NATURAL;
--| Purpose
--| Set and return the value of the centering count.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Underline_Count . SPEC
-- . Underline_Count .
-- . .
-- ..................................
procedure Set_Underline_Count
( Value : in NATURAL );
function Underline_Count
return NATURAL;
--| Purpose
--| Set and return the value of the underline count.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Cc . SPEC
-- . Cc .
-- . .
-- ..................................
Default_Cc
: constant CHARACTER
:= '.';
procedure Set_Cc
( Item : in CHARACTER );
function Cc
return CHARACTER;
--| Purpose
--| Set and return the value of the command control character.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Ec . SPEC
-- . Ec .
-- . .
-- ..................................
Default_Ec
: constant CHARACTER
:= '_';
procedure Set_Ec
( Item : in CHARACTER );
function Ec
return CHARACTER;
--| Purpose
--| Set and return the value of the escape character.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Fc . SPEC
-- . Fc .
-- . .
-- ..................................
Default_Fc
: constant CHARACTER
:= '@';
procedure Set_Fc
( Item : in CHARACTER );
function Fc
return CHARACTER;
--| Purpose
--| Set and return the value of the flag character.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Nr . SPEC
-- . Nr .
-- . .
-- ..................................
subtype NREG is
CHARACTER range 'a' .. 'z';
procedure Set_Nr
( Item : in NREG;
Value : in NATURAL );
function Nr
( Item : in NREG )
return NATURAL;
procedure Nr
( Item : in NREG;
Value : out STRING;
Last : out NATURAL );
--| Purpose
--| Set and return the value of a number register.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_Var . SPEC
-- . Var .
-- . .
-- ..................................
procedure Set_Var
( Name : in STRING;
Value : in STRING );
function Var
( Name : in STRING )
return STRING;
procedure Var
( Name : in STRING;
Value : out STRING;
Last : out NATURAL );
--| Purpose
--| Set and return the value of a user-defined text variable.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Set_File_Name . SPEC
-- . Get_File_Name .
-- . Set_Line_Number .
-- . Increment_Line_Number .
-- . Line_Number .
-- . .
-- ..................................
procedure Set_File_Name
( Name : in STRING );
function Get_File_Name
return STRING;
procedure Set_Line_Number
( Value : in NATURAL );
procedure Increment_Line_Number;
function Line_Number
return NATURAL;
--| Purpose
--| Set and return the name of the current input file. Also
--| increment and return the line number (Set_File_Name zeroes
--| the line number).
--|
--| Exceptions (none)
--| Notes (none)
end Variable;
--::::::::::
--parse.a
--::::::::::
-- ..................................
-- . .
-- . Parse . SPEC & BODY
-- . .
-- ..................................
procedure Parse
( Item : in STRING;
Command_Verb : out STRING;
Command_Tail : out STRING;
Verb_Last : out NATURAL;
Tail_Last : out NATURAL ) is
--| Purpose
--| Parse parses the input string, which does not begin with a dot, into
--| the strings Command_Verb and Command_Tail. Verb_Last and Tail_Last
--| are set to the index of the last valid character. Command_Verb
--| starts with the first character. Command_Tail
--| starts with the first non-blank character after the verb.
--| The string Item is of the form:
--| command_verb command_tail
--|
--| Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
First
: NATURAL;
Last
: NATURAL;
Temp
: NATURAL;
begin -- Parse
Verb_Last := Command_Verb'First - 1;
Tail_Last := Command_Tail'First - 1;
if Item'Length > 0 then
First := Item'First;
Last := Item'Last;
for I in First .. Item'Last loop
if Item(I) <= ' ' then
Last := I - 1;
exit;
end if;
end loop;
Temp := Last - First + Command_Verb'First;
Verb_Last := Temp;
Command_Verb(Command_Verb'First .. Temp) := Item(First .. Last);
Last := Last + 1;
if Last <= Item'Last then
First := Item'Last + 1;
for I in Last .. Item'Last loop
if Item(I) > ' ' then
First := I;
exit;
end if;
end loop;
if First <= Item'Last then
Temp := Item'Last - First + Command_Tail'First;
Tail_Last := Temp;
Command_Tail(Command_Tail'First .. Temp) := Item(First .. Item'Last);
end if;
end if;
end if;
end Parse;
--::::::::::
--fof.a
--::::::::::
-- **********************************
-- * *
-- * Formatted_Output_File * SPEC
-- * *
-- **********************************
package Formatted_Output_File is
--| Purpose
--| Text_Formatter manipulates objects of type STRING (text), placing
--| text into the output file as it is received. Text_Formatter is
--| also used to define the format of the text (number of lines per page,
--| header, footer, etc.).
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial version
type FILE is
private;
Maximum_Number_Of_Lines_On_Page
: constant
:= 200;
Maximum_Line_Length
: constant
:= 200;
Maximum_Number_Of_Header_Footer_Lines
: constant
:= 8;
Maximum_Number_Of_Pages
: constant
:= 32000;
pragma Format_Off;
type PAGE_ATTRIBUTE is
( TOP_MARGIN, -- Number of lines before first header
BOTTOM_MARGIN, -- Number of lines after last footer
LEFT_MARGIN, -- Column num of the last col before the 1st char
RIGHT_MARGIN, -- Column number of the last char of the line
LEFT_INDENT, -- Number of columns to indent from LEFT_MARGIN
RIGHT_INDENT, -- Number of columns to indent from RIGHT_MARGIN
TOTAL_LINES, -- Number of lines on a page
HEADER_LINES, -- Number of lines in the header
FOOTER_LINES, -- Number of lines in the footer
LINE_SPACING, -- Number of blank lines after each text line
PAGE_OFFSET, -- Number of columns to offset each line
TEMP_INDENT -- Number of columns to indent next line only
-- (this is an absolute value, not influenced
-- by the LEFT_MARGIN or LEFT_INDENT settings)
);
type LINE_ATTRIBUTE is
( BOLD, -- Make words come out bold (overstrike)
CENTER, -- Center lines (Put_Line with No Fill)
FILL, -- Successively place words into an output
-- line until the next word will not fit
-- between the left and right margins
-- (with indents)
FILL_STATE_BEFORE_CENTER, -- Save area for FILL
JUSTIFY, -- Fill output line to RIGHT_MARGIN -
-- RIGHT_INDENT with spaces between words
PAGING, -- Break output on page boundaries,
-- outputting footer, bottom margin,
-- top margin, and header
UNDERLINE, -- Underline words
UNDERLINE_PUNCT, -- If ON, underline punctuation
USE_FORM_FEED -- Use form feeds to eject pages
);
type PAGE_ATTRIBUTE_LIST is
array (PAGE_ATTRIBUTE)
of NATURAL;
type OFF_ON is
( OFF, ON );
type LINE_ATTRIBUTE_LIST is
array (LINE_ATTRIBUTE)
of OFF_ON;
Page_Attribute_Defaults
: constant PAGE_ATTRIBUTE_LIST
:= (
TOP_MARGIN => 4,
BOTTOM_MARGIN => 4,
LEFT_MARGIN => 12,
RIGHT_MARGIN => 90,
LEFT_INDENT => 0,
RIGHT_INDENT => 0,
TOTAL_LINES => 66,
HEADER_LINES => 2,
FOOTER_LINES => 2,
LINE_SPACING => 0,
PAGE_OFFSET => 0,
TEMP_INDENT => 0 );
Line_Attribute_Defaults
: constant LINE_ATTRIBUTE_LIST
:= (
BOLD => OFF,
CENTER => OFF,
FILL => ON,
FILL_STATE_BEFORE_CENTER => ON,
JUSTIFY => ON,
PAGING => ON,
UNDERLINE => OFF,
UNDERLINE_PUNCT => OFF,
USE_FORM_FEED => ON );
pragma Format_On;
Page_Number_Id_Default
: constant CHARACTER
:= '#';
type LINE_NUMBER is
new INTEGER range 0 .. Maximum_Number_Of_Lines_On_Page;
type HEADER_FOOTER_LINE is -- H/F line numbers
new INTEGER range 1 .. Maximum_Number_Of_Header_Footer_Lines;
type PAGE_NUMBER is
new INTEGER range 0 .. Maximum_Number_Of_Pages;
type STATUS is -- for Open
( OK, NOT_OK );
type PAGE_SIDE is -- for margins and indents
( LEFT_SIDE, RIGHT_SIDE );
type PAGE_KIND is -- for headers and footers
( EVEN_PAGES, ODD_PAGES, ALL_PAGES );
type NUMERIC_FORMAT is -- for page numbers
( ARABIC, LOWER_ROMAN, UPPER_ROMAN );
Range_Error
: exception;
File_Not_Open
: exception;
-- ..................................
-- . .
-- . Open . SPEC
-- . .
-- ..................................
procedure Open
( Item : in out FILE;
File_Name : in STRING;
Result : out STATUS );
--| Purpose
--| Open the formatted output file for subsequent processing.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close
( Item : in FILE );
--| Purpose
--| Close the formatted output file.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Put_Invisible_Word . SPEC
-- . .
-- ..................................
procedure Put_Invisible_Word
( Item : in FILE;
What : in STRING );
--| Purpose
--| Add a word to the current line and do not increment the
--| character count.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Put_Word . SPEC
-- . .
-- ..................................
procedure Put_Word
( Item : in FILE;
What : in STRING );
--| Purpose
--| Add a word to the current line.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Put_Line . SPEC
-- . .
-- ..................................
procedure Put_Line
( Item : in FILE;
What : in STRING );
--| Purpose
--| Add a line to the current page. If line break, insert blank
--| lines as per LINE_SPACING.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Break_Line . SPEC
-- . .
-- ..................................
procedure Break_Line
( Item : in FILE );
--| Purpose
--| Break the current line (if it contains any words, output them).
--| Insert blank lines as per the LINE_SPACING setting.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Current_Line . SPEC
-- . .
-- ..................................
function Current_Line
( Item : in FILE )
return LINE_NUMBER;
--| Purpose
--| Return the number of the current line.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Skip . SPEC
-- . .
-- ..................................
procedure Skip
( Item : in FILE;
Number_Of_Lines : in LINE_NUMBER := 1 );
--| Purpose
--| Skip Number_Of_Lines in the output after first issuing a Break_Line.
--| LINE_SPACING influences the actual number of lines skipped.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Break_Page . SPEC
-- . Break_Page .
-- . .
-- ..................................
procedure Break_Page
( Item : in FILE );
--| Purpose
--| If there is anything on the current page, output it and advance
--| to the next page.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
procedure Break_Page
( Item : in FILE;
New_Page_Num : in PAGE_NUMBER );
--| Purpose
--| If there is anything on the current page, output it and advance
--| to the next page. Set the number of the next page to New_Page_Num.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Current_Page . SPEC
-- . .
-- ..................................
function Current_Page
( Item : in FILE )
return PAGE_NUMBER;
--| Purpose
--| Return the number of the current page.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Current_Page . SPEC
-- . .
-- ..................................
function Current_Page
( Item : in FILE )
return STRING;
--| Purpose
--| Return the number of the current page as a string.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Page_Number_Format . SPEC
-- . .
-- ..................................
procedure Set_Page_Number_Format
( Item : in FILE;
To : in NUMERIC_FORMAT;
Format_String : in STRING );
--| Purpose
--| Set the format of the page number. If the Format_String is not
--| null, the page numbers in the headers and footers will appear as
--| indicated (with the literal number substituted for # characters).
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Page_Attribute . SPEC
-- . .
-- ..................................
procedure Set_Page_Attribute
( Item : in FILE;
What : in PAGE_ATTRIBUTE;
To : in NATURAL );
--| Purpose
--| Set a specified page attribute.
--|
--| Exceptions
--| Range_Error raised if To is outside the range for What
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Line_Attribute . SPEC
-- . .
-- ..................................
procedure Set_Line_Attribute
( Item : in FILE;
What : in LINE_ATTRIBUTE;
To : in OFF_ON );
--| Purpose
--| Turn off or on the indicated attribute for the current and
--| following lines.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Get_Page_Attribute . SPEC
-- . .
-- ..................................
function Get_Page_Attribute
( Item : in FILE;
What : in PAGE_ATTRIBUTE )
return NATURAL;
--| Purpose
--| Get a specified page attribute.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Get_Line_Attribute . SPEC
-- . .
-- ..................................
function Get_Line_Attribute
( Item : in FILE;
What : in LINE_ATTRIBUTE )
return OFF_ON;
--| Purpose
--| Get the indicated attribute for the current and
--| following lines.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Test_Page . SPEC
-- . .
-- ..................................
function Test_Page
( Item : in FILE;
Number_Of_Lines : in LINE_NUMBER )
return BOOLEAN;
--| Purpose
--| Return TRUE if Number_Of_Lines is remaining on the current page.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Footer_Line . SPEC
-- . .
-- ..................................
procedure Set_Footer_Line
( Item : in FILE;
Class : in PAGE_KIND;
Number : in HEADER_FOOTER_LINE;
Left_Text : in STRING;
Center_Text : in STRING;
Right_Text : in STRING );
--| Purpose
--| Store a footer line for EVEN, ODD, or ALL pages.
--| The footer line is dynamically adjusted, based on the left and right
--| margin settings. The strings Left, Center, and Right are left-
--| justified, centered, and right-justified in the indicated footer
--| line, respectively.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Header_Line . SPEC
-- . .
-- ..................................
procedure Set_Header_Line
( Item : in FILE;
Class : in PAGE_KIND;
Number : in HEADER_FOOTER_LINE;
Left_Text : in STRING;
Center_Text : in STRING;
Right_Text : in STRING );
--| Purpose
--| Store a header line for EVEN, ODD, or ALL pages.
--| The header line is dynamically adjusted, based on the left and right
--| margin settings. The strings Left, Center, and Right are left-
--| justified, centered, and right-justified in the indicated header
--| line, respectively.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Page_Number_Id . SPEC
-- . .
-- ..................................
procedure Set_Page_Number_Id
( Item : in FILE;
To : in CHARACTER );
--| Purpose
--| Set the character used to represent the page number in the
--| header and footer lines of the output file.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Set_Page_Number_Format . SPEC
-- . .
-- ..................................
procedure Set_Page_Number_Format
( Item : in FILE;
To : in NUMERIC_FORMAT );
--| Purpose
--| Set the format used to represent the page number in the
--| header and footer lines of the output file.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
-- ..................................
-- . .
-- . Page_Number_Format . SPEC
-- . .
-- ..................................
function Page_Number_Format
( Item : in FILE )
return NUMERIC_FORMAT;
--| Purpose
--| Get the format used to represent the page number in the
--| header and footer lines of the output file.
--|
--| Exceptions
--| File_Not_Open
--|
--| Notes (none)
private -- Formatted_Output_File
type FILE_OBJECT;
type FILE is
access FILE_OBJECT;
end Formatted_Output_File;
--::::::::::
--cnt.a
--::::::::::
-- **********************************
-- * *
-- * Contents * SPEC
-- * *
-- **********************************
with Formatted_Output_File;
package Contents is
--| Purpose
--| Contents_Page adds lines to the table of contents and
--| prints the table of contents. Once the table of contents
--| has been printed, no more lines may be added to it.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
subtype TABLE_NUMBER is
NATURAL range 0 .. 5;
-- ..................................
-- . .
-- . Select_Table . SPEC
-- . .
-- ..................................
procedure Select_Table
( Which_Table : in TABLE_NUMBER );
--| Purpose
--| Select_Table selects one of the tables of contents.
--| The Add_Line and Print routines below operate on the last table
--| selected. Table 0 is selected by default.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Add_Line . SPEC
-- . .
-- ..................................
procedure Add_Line
( Level : in NATURAL;
Line : in STRING;
Page_Number : in STRING );
--| Purpose
--| Add_Line adds a line, at the indicated indentation level, to
--| the table of contents.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Print . SPEC
-- . .
-- ..................................
procedure Print
( Target : in Formatted_Output_File.File;
Spaces_Per_Level : in NATURAL );
--| Purpose
--| Print prints the table of contents, indenting every Spaces_Per_Level
--| at each indentation level.
--|
--| Exceptions (none)
--| Notes (none)
end Contents;
--::::::::::
--env.a
--::::::::::
-- **********************************
-- * *
-- * Environment * SPEC
-- * *
-- **********************************
with Formatted_Output_File;
package Environment is
--| Purpose
--| Environment provides a mechanism for saving the current environment
--| and then later restoring it. The environment consists of the
--| page attribute list and the line attribute list of the indicated
--| Formatted_Output_File object. It also consists of the three formatter
--| key characters (Cc, Ec, and Fc).
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Add Set_Underlining to Pop/Push
-- ..................................
-- . .
-- . Pop . SPEC
-- . .
-- ..................................
procedure Pop
( Item : in Formatted_Output_File.File;
Set_Bolding : in out BOOLEAN;
Set_Underlining : in out BOOLEAN );
--| Purpose
--| Pop pops the attributes off the stack. If the stack is empty,
--| Pop writes an error message.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Push . SPEC
-- . .
-- ..................................
procedure Push
( Item : in Formatted_Output_File.File;
Set_Bolding : in BOOLEAN;
Set_Underlining : in BOOLEAN );
--| Purpose
--| Push pushes the attributes onto the stack. If the stack is full,
--| Push writes an error message.
--|
--| Exceptions (none)
--| Notes (none)
end Environment;
--::::::::::
--mac.a
--::::::::::
-- **********************************
-- * *
-- * Macro * SPEC
-- * *
-- **********************************
package Macro is
--| Purpose
--| Macro is used to manipulate an abstract state machine
--| which contains a group of macro definitions. It provides routines
--| for building new macro definitions and extracting the lines from
--| a macro definition.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
type MACRO_ID is
private;
type MACRO_STATUS is
( NOT_OK, OK );
Macro_Not_In_Add_Mode
: exception;
Macro_Not_Open
: exception;
-- ..................................
-- . .
-- . Create . SPEC
-- . .
-- ..................................
procedure Create
( Macro_Name : in STRING;
Id : in out MACRO_ID;
Status : out MACRO_STATUS );
--| Purpose
--| Define and initialize a new macro. Return a Status of OK if the
--| program may proceed with calls to Write. The programmer should
--| create a new macro by taking the following steps:
--| 1. Call Create to create the macro
--| 2. If status is OK, then
--| 2.1. Call Write as necessary to write lines into the macro
--| 2.2. Call Close to close the macro
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Write . SPEC
-- . .
-- ..................................
procedure Write
( Id : in out MACRO_ID;
Line : in STRING );
--| Purpose
--| Write adds the indicated line to the macro opened with Create.
--|
--| Exceptions
--| Macro_Not_In_Add_Mode Macro was not opened with Create
--|
--| Notes (none)
-- ..................................
-- . .
-- . Open . SPEC
-- . .
-- ..................................
procedure Open
( Macro_Name : in STRING;
Id : out MACRO_ID;
Status : out MACRO_STATUS );
--| Purpose
--| Open the indicated macro for subsequent reading. The programmer should
--| take the following steps to read a macro:
--| 1. Open the macro
--| 2. If status is OK, then:
--| 2.1. If not Is_Empty, then
--| 2.1.1. Read next line from macro
--| 2.1.2. Loop back to 2.1
--| 2.2. Close the macro
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Is_Empty . SPEC
-- . .
-- ..................................
function Is_Empty
( Id : in MACRO_ID )
return BOOLEAN;
--| Purpose
--| Is_Empty is the basis for a loop iterator, indicating if any more
--| lines are available from the indicated macro.
--|
--| Exceptions
--| Macro_Not_Open The macro has not been opened
--|
--| Notes (none)
-- ..................................
-- . .
-- . Read . SPEC
-- . .
-- ..................................
procedure Read
( Id : in out MACRO_ID;
Item : out STRING;
Last : out NATURAL );
--| Purpose
--| Read reads the next line from the indicated macro.
--|
--| Exceptions
--| Macro_Not_Open The macro has not been opened
--|
--| Notes (none)
-- ..................................
-- . .
-- . Close . SPEC
-- . .
-- ..................................
procedure Close
( Id : in out MACRO_ID );
--| Purpose
--| Close the indicated macro from reading or writing. If the macro was
--| opened by a call to Open, then access to it is simply closed. If the
--| macro was opened by a call to Create, then no more lines may be added
--| to it.
--|
--| Exceptions
--| Macro_Not_Open The macro has not been opened
--|
--| Notes
--| Close performs differently if the macro was opened by Create or Open.
-- ..................................
-- . .
-- . Locate . SPEC
-- . .
-- ..................................
function Locate
( Macro_Name : in STRING )
return MACRO_STATUS;
--| Purpose
--| Locate determines if the indicated macro is already defined (created
--| by calls to Create, Write, and Close). If so, Locate returns OK, else
--| Locate returns NOT_OK.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Define_Parameters . SPEC
-- . .
-- ..................................
procedure Define_Parameters
( Macro_Name : in STRING;
Parameters : in STRING );
--| Purpose
--| Define_Parameters creates the variables @0 to @9 for reference by
--| commands within a macro.
--|
--| Exceptions (none)
--| Notes (none)
private -- Macro
type MACRO_DEFINITION; -- deferred to body
type MACRO_ID is
access MACRO_DEFINITION;
end Macro;
--::::::::::
--cmd.a
--::::::::::
-- **********************************
-- * *
-- * Command * SPEC
-- * *
-- **********************************
with Command_Symbols;
with Formatted_Output_File;
with Input_File;
package Command is
--| Purpose
--| Command provides all the command identification and processing
--| functions for the word processor.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
-- ..................................
-- . .
-- . Identify . SPEC
-- . .
-- ..................................
function Identify
( Item : in STRING )
return Command_Symbols.Command_Id;
--| Purpose
--| Identify_Command determines the COMMAND_ID of the indicated
--| command name. Item should not contain the leading dot
--| or any trailing or embedded spaces or characters. If the
--| Item does not contain any known command, a COMMAND_ID of UNKNOWN
--| is returned.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Process . SPEC
-- . .
-- ..................................
procedure Process
( Id : in Command_Symbols.Command_Id;
Line_Tail : in STRING;
Target : in out Formatted_Output_File.File;
Input_File_Id : in out Input_File.File_Type );
--| Purpose
--| Process_Command processes the indicated command on the indicated Target
--| file. Line_Tail contains the text following the command verb from the
--| dot command line (i.e., dot command is ".command_verb text").
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Disable_Bolding . SPEC
-- . .
-- ..................................
procedure Disable_Bolding;
--| Purpose
--| Disable_Bolding allows the caller to initially disable the bold
--| face feature of the system (useful if the document is a draft).
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Disable_Underlining . SPEC
-- . .
-- ..................................
procedure Disable_Underlining;
--| Purpose
--| Disable_Underlining allows the caller to initially disable the
--| underlining feature of the system (useful if the document is a
--| draft).
--|
--| Exceptions (none)
--| Notes (none)
end Command;
--::::::::::
--wp.a
--::::::::::
-- **********************************
-- * *
-- * Word_Processor * SPEC
-- * *
-- **********************************
package Word_Processor is
--| Purpose
--| Word_Processor is an abstract state machine which reads one or
--| more input text files, processing text and commands from them,
--| placing the output into a common output file. The output file
--| must be opened before any of the input files are processed.
--|
--| Initialization Exceptions (none)
--| Notes (none)
--|
--| Modifications
--| 08/16/89 Rick Conn Initial Version
--| 02/26/90 Rick Conn Add Disable Underlining Flag
type OPERATION_STATUS is
( NOT_OK, OK );
Output_File_Not_Open
: exception;
-- ..................................
-- . .
-- . Open_Output_File . SPEC
-- . .
-- ..................................
function Open_Output_File
( File_Name : in STRING;
Page_Offset : in NATURAL;
Disable_Bolding : in BOOLEAN;
Disable_Underlining : in BOOLEAN )
return OPERATION_STATUS;
--| Purpose
--| Open_Output_File opens the output file. If it cannot be opened,
--| the status of NOT_OK is returned.
--|
--| Exceptions (none)
--| Notes (none)
-- ..................................
-- . .
-- . Process_Source_File . SPEC
-- . .
-- ..................................
function Process_Source_File
( File_Name : in STRING )
return OPERATION_STATUS;
--| Purpose
--| Process_Source_File processes the lines from the indicated source file.
--| It may be called recursively.
--|
--| Exceptions
--| Output_File_Not_Open The destination output file is not opened
--|
--| Notes (none)
-- ..................................
-- . .
-- . Close_Output_File . SPEC
-- . .
-- ..................................
procedure Close_Output_File;
--| Purpose
--| Close_Output_File closes the output file.
--|
--| Exceptions (none)
--| Notes (none)
end Word_Processor;